home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / sort_stm.zip / TEST.PAS < prev   
Pascal/Delphi Source File  |  1992-10-18  |  5KB  |  187 lines
  1. Program Test;
  2. {a complete Testing and development program for demonstrating the indexed }
  3. {Stream Methods/objects}
  4.  
  5. uses DOS,Objects,SIndexed,crt;
  6.  
  7. Type
  8.    pTestObj = ^Testobj;
  9.    TestObj  = OBJECT(IndexObj)
  10.      company: Pstring;
  11.      amountOwed: Real;
  12.      Constructor INIT(Comp: String; Amount: Real);
  13.      Destructor Done;                                  VIRTUAL;
  14.      Function COMPARE(t: pIndex): Integer;             VIRTUAL;
  15.      Constructor Load(VAR s:tstream);
  16.      Procedure store(VAR s: tstream);
  17.    end;
  18.  
  19.  
  20. var Index: pSortedIndex;
  21.     SearchObj: pTestObj;
  22.  
  23. const
  24.   RtestObj: TStreamRec = (
  25.     ObjType: 10000;
  26.     VmtLink: Ofs(TypeOf(TestObj)^);
  27.     Load: @testObj.Load;
  28.     Store: @TestObj.Store);
  29.  
  30. {this controls how many "dummy" records are created for our test purposes!}
  31. {during creation, program can store about 300 or so records per MINUTE}
  32. {when using a SORTEDIndexstream or about 1250 when using a indexstream}
  33. {however the SEARCH routines on an indexstream are CONSIDERABLY slower then}
  34. {a Sorted stream}
  35.     ITemMax: word = 1000;
  36.  
  37. CONSTRUCTOR TestObj.Init(Comp: String; amount: Real);
  38. begin
  39.    IndexObj.Init;
  40.    Company:=NewStr(comp);
  41.    amountOwed:=Amount;
  42. end;
  43.  
  44. DESTRUCTOR TestObj.Done;
  45. begin
  46.    if Company<>NIL then
  47.      disposeStr(company);
  48.    tobject.done;
  49. end;
  50.  
  51. CONSTRUCTOR TestObj.Load(VAR s: tStream);
  52. begin
  53.  
  54.    Company:=s.ReadStr;
  55.    s.Read(AmountOwed,Sizeof(AmountOwed));
  56. end;
  57.  
  58. Procedure Testobj.Store(VAR s: tStream);
  59. begin
  60.    s.WriteStr(Company);
  61.    s.Write(AmountOwed,sizeof(AmountOwed));
  62. end;
  63.  
  64. FUNCTION testObj.Compare(T: pIndex): Integer;
  65. VAR TEST: pTestObj Absolute T;
  66. begin
  67.    if Test^.Company^ < Company^ then compare :=1 else
  68.       if Test^.Company^ = Company^ then Compare:=0 else
  69.         Compare:=-1;
  70. {   writeln('SEARCHING: ',Test^.Company^:15,' Against ',Company^);
  71.    write('Press any key...');
  72.    readln;
  73.    writeln;}
  74. end;
  75.  
  76. Procedure RegisterTest;
  77. begin
  78.    RegisterType(rTestobj);
  79. end;
  80.  
  81. Procedure StoreSomeData;
  82. VAR I,N,X,Ourpos: Word;
  83.     s: String;
  84.     amt: Real;
  85.     temp: pTestObj;
  86. begin
  87.    Temp:=New(pTestObj,Init('',0.00));
  88.    OurPos:=ItemMax - 2; {store a KNOWN record at this position!}
  89.  
  90.    Randomize;
  91.    for I:=0 to ItemMax do
  92.    begin
  93.        if I=ourpos then
  94.        begin
  95.           S:='OUR COMPANY';
  96.           Amt:=1.48;
  97.        end
  98.        else
  99.        begin
  100.           s:='';
  101.           for N:=1 to 9 do
  102.               S:=S+CHR(RANDOM(24)+65);
  103.           X:=Random(10)+1;
  104.           for N:=1 to X do
  105.               S:=S+CHR(RANDOM(24)+65);
  106.           amt:=Random(1000)*1.4951;
  107.        end;
  108.        Writeln(I:4,' Creating ',s,Amt:10:2);
  109.  
  110.        if Temp^.Company<>NIL then
  111.          disposeStr(temp^.Company);
  112.        Temp^.Company:=NewStr(S);
  113.        Temp^.Amountowed:=Amt;
  114.  
  115.        Index^.Insert(Temp);    {note call to INSERT and NOT PUT!}
  116.    end;
  117. end;
  118.  
  119. Procedure SearchMe;
  120. {search indexstream for objects test routine only!}
  121. VAR searchobj: ptestObj;
  122.     s: String;
  123.     Searches,N,X: Byte;
  124. begin
  125.   {Now FINALLY Set up and do our search!}
  126.   SearchObj:=NEW(pTestObj,Init('OUR COMPANY',0.00));
  127.   if SearchObj<>NIL then
  128.   begin
  129.     {search for our KNOWN name...}
  130.     write('Searching for: ',searchobj^.Company^,'...');
  131.     if Index^.Find(SearchObj) then
  132.        writeln('FOUND!') else Writeln('NOT FOUND!');
  133.  
  134.     for Searches:=1 to 5 do  {now search for 5 randomly generated names...}
  135.     begin
  136.        s:='';
  137.        for N:=1 to 9 do
  138.            S:=S+CHR(RANDOM(24)+65);
  139.        X:=Random(10)+1;
  140.        for N:=1 to X do
  141.            S:=S+CHR(RANDOM(24)+65);
  142.        {Replace company name...}
  143.        if searchobj^.Company<>NIL then
  144.          disposestr(Searchobj^.Company);
  145.        Searchobj^.Company:=NewStr(S);
  146.  
  147.        write('Searching for: ',searchobj^.Company^,'...');
  148.        if Index^.Find(SearchObj) then
  149.           writeln('FOUND!') else Writeln('NOT FOUND!');
  150.     end;
  151.   end;
  152.   writeln('Stream contains ',Index^.ItemCount,' Items');
  153. end;
  154.  
  155. {Simply displays entire contents of stream...}
  156. Procedure PrintMe;
  157. VAR Tmp: pTestObj;
  158. begin
  159.    Index^.ItemPos(0);
  160.    while Index^.GetPos<Index^.GetSize do
  161.    begin
  162.       Tmp:=pTestObj(Index^.get);
  163.       writeln(Tmp^.Company^,Tmp^.AmountOwed:10:2);
  164.       dispose(tmp,done);
  165.    end;
  166. end;
  167.  
  168. begin
  169.   RegisterTest;
  170.   Index:=NEW(pSortedIndex,INIT(64*1024,'TEST.DAT'));
  171.  
  172.   if Index^.ItemCount=0 then
  173.     storesomedata;
  174.  
  175.   searchMe;
  176.  
  177. (*  Index^.ReBuild;  {test redindex procedure}
  178.   writeln;
  179.   Searchme;     {verify Rebuild} *)
  180.  
  181. {  PrintMe; }  {uncomment if you wish to see sorted list printed}
  182.  
  183.   Writeln;
  184.  
  185.   dispose(Index,done);
  186. end.
  187.